home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / drdobbs / 1989 / 08 / floyd.lst < prev    next >
File List  |  1989-07-06  |  9KB  |  344 lines
  1. THE C-TO-FORTRAN CONNECTION
  2. by Michael Floyd
  3.  
  4.  
  5. [LISTIN╟ ONE]
  6.  
  7. /* DOT.C - uses Lahey FORTRAN's random number generator to randomly
  8.        place pixels on the screen.
  9.            This example demonstrates how to call F77L functions and
  10.        subroutines from a C program.
  11.            Uses Initialize() from Borland's BGIDEMO example to
  12.        perform hardware detection, load the appropriate BGI
  13.        driver and initialize the system to graphics mode.
  14.            Link line using Borland's TLINK is as follows:
  15.            link bcf77l.150+c0l+frand+do_frand,frand,,emu+mathl+cl+f77l
  16. */
  17.  
  18. #include <stdio.h>
  19. #include <stdlib.h>
  20. #include <graphics.h>
  21.  
  22. char *DriverNames[] = {
  23.   "Detect",
  24.   "CGA",
  25.   "EGA",
  26.   "HercMono",
  27.   "VGA"
  28. };
  29.  
  30. struct PTS {
  31.   int x, y;
  32. };    /* Structure to hold vertex points    */
  33.  
  34. int    GraphDriver;        /* The Graphics device driver        */
  35. int    GraphMode;        /* The Graphics mode value        */
  36. double AspectRatio;        /* Aspect ratio of a pixel on the screen*/
  37. int    MaxX, MaxY;        /* The maximum resolution of the screen */
  38. int    MaxColors;        /* The maximum # of colors available    */
  39. int    ErrorCode;        /* Reports any graphics errors        */
  40. struct palettetype palette;        /* Used to read palette info    */
  41.  
  42. /*                                    */
  43. /*    Function prototypes                        */
  44. /*                                    */
  45.  
  46. extern void frand (int *, int *);
  47. extern void seed_rnd (int *);
  48. void Initialize(void);
  49. void RandomDot(void);
  50.  
  51. /* Begin main() */
  52.  
  53. main()
  54. {
  55.   Initialize();            /* Set system into Graphics mode    */
  56.   RandomDot();                  /* Place pixels at random locations     */
  57.   closegraph();            /* Return the system to text mode    */
  58.  
  59. } /* End main() */è
  60. /*    INITIALIZE: Initializes the graphics system and reports        */
  61. /*    any errors which occured.                    */
  62.  
  63. void Initialize(void)
  64. {
  65.   int xasp, yasp;            /* Used to read the aspect ratio*/
  66.  
  67.   GraphDriver = DETECT;            /* Request auto-detection    */
  68.   initgraph( &GraphDriver, &GraphMode, "" );
  69.   ErrorCode = graphresult();        /* Read result of initialization*/
  70.   if( ErrorCode != grOk ){        /* Error occured during init    */
  71.     printf(" Graphics System Error: %s\n", grapherrormsg( ErrorCode ) );
  72.     exit( 1 );
  73.   }
  74.  
  75.   getpalette( &palette );        /* Read the palette from board    */
  76.   MaxColors = getmaxcolor() + 1;    /* Read maximum number of colors*/
  77.  
  78.   MaxX = getmaxx();
  79.   MaxY = getmaxy();                     /* Read size of screen */
  80.  
  81.   getaspectratio( &xasp, &yasp );    /* read the hardware aspect    */
  82.   AspectRatio = (double)xasp / (double)yasp; /* Get correction factor    */
  83.  
  84. } /* End Initialize */
  85.  
  86. void RandomDot(void)
  87. {
  88.   int seed;
  89.   int i, x, y, height, width, rand_val, color, temp;
  90.   struct viewporttype vp;
  91.  
  92.   getviewsettings( &vp );
  93.   height = vp.bottom - vp.top;
  94.   width = vp.right    - vp.left;
  95.  
  96.   seed_rnd( &seed );      /* Seed F77L's Random # Gen. Output discarded */
  97.  
  98.   for( i=0 ; i<1000 ; ++i ){        /* Put 1000 pixels on screen    */
  99.     temp = width - 1;
  100.     frand( &rand_val, &temp );    /* Call F77L's RND function     */
  101.     x = rand_val + 1;
  102.     temp = height - 1;
  103.     frand( &rand_val, &temp );
  104.     y = rand_val + 1;
  105.     frand( &rand_val, &MaxColors );
  106.     color = rand_val;
  107.     putpixel( x, y, color );
  108.   } /* End for loop */
  109.  
  110. } /* End RandomDot() */
  111.  
  112.  
  113. [LISTING TWO]
  114.  
  115. c
  116. c FRAND.FOR - Calls F77L's random Number generator RND. 
  117. c             Demonstrates how to call a FORTRAN function from C
  118. c
  119. c             Inputs :  None
  120. c             Outputs: RETVAL
  121.  
  122.         FUNCTION FRAND(N)
  123.  
  124.         BCEXTERNAL FRAND
  125.         INTEGER*2 N, FRAND
  126.  
  127.           FRAND = INT(RND() * N )
  128.           RETURN
  129.       END
  130.  
  131. c
  132. c SEED_RND - Used to seed F77L's random Number generator.
  133. c            Demonstrates how to call a FORTRAN subroutine from C
  134. c
  135. c            Inputs :  None
  136. c            Outputs: RETVAL
  137.  
  138.       SUBROUTINE SEED_RND(RETVAL)
  139.  
  140.         BCEXTERNAL SEED_RND
  141.         INTEGER*2 RETVAL
  142.  
  143.         RETVAL = INT(RRAND())
  144.         RETURN
  145.       END
  146.  
  147.  
  148.  
  149.  
  150.  
  151. [LISTING THREE]
  152.  
  153. c
  154. c     SEARCH.FOR uses rnd() to generate a list of random values
  155. c     that are then passed to C's qsort routine for sorting in 
  156. c     ascending and descending order. Once sorted, the values 
  157. c     are dislayed and the user is prompted for a value to search
  158. c     for. The input value is passed to C's bsearch function and
  159. c     the results of the search are displayed
  160. c
  161. c     To link, use the following command line:
  162. c
  163. c     tlink f77lbc.150+search+do_srch,search,,emu+mathl+cl+f77l
  164. c
  165.       PROGRAM SEARCH
  166.  
  167.       BCEXTERNAL q_sort, bin_search
  168.       INTEGER*2 A(0:20), B(0:20), C(0:20), I, J
  169.       INTEGER*2 FOUND, bin_search, VAL, R
  170.  
  171.       DO 10 I = 0, 19
  172.          A(I) = 0
  173.          B(I) = 0
  174.          C(I) = 0
  175. 10     CONTINUE
  176.  
  177.          R = rrand()
  178.          PRINT *, R
  179.       DO 20 I = 0, 19
  180.  
  181.          A(I) = 32767.0 * rnd()
  182.          B(I) = A(I)
  183.          C(I) = A(I)
  184.  
  185. 20    CONTINUE
  186.  
  187.       PRINT *, 'Input    Ascending    Descending'
  188.       PRINT *, '════════════════════════════════'
  189.       call q_sort(A,20,0)
  190.       call q_sort(B,20,1)
  191.       DO 30 J = 0, 19
  192.          PRINT 40, C(J), A(J), B(J)
  193.  
  194. 30    CONTINUE
  195. 40    FORMAT(I6,I13,I13)
  196.       PRINT *, 'Enter value to search for: '
  197.       READ *, VAL
  198.       FOUND = bin_search(A, 20, VAL)
  199.       IF (FOUND .NE. 0) THEN
  200.          PRINT *, VAL, ' found in list!'
  201.       ELSE
  202.          PRINT *, VAL, ' NOT found!'
  203.       ENDIF
  204.  
  205.       END
  206.  
  207.  
  208.  
  209. [LISTING FOUR]
  210.  
  211. /*      do_srch.c
  212. **    q_sort()
  213. **    This function will take a one dimensional array of length n and
  214. **    integer width and will sort it in ascending or descending order.
  215. **    Nothing is returned -- status always equals zero if any checking
  216. **    is done by the FORTRAN calling program.
  217. **               inputs: array      ptr to array
  218. **                       length     number of elements in array
  219. **                       order      0 = ascending
  220. **                                  1 = descending
  221. **               output: none
  222. */
  223. #include <stdio.h>
  224. #include <stdlib.h>
  225.  
  226. int q_sort (void *array,int *length,int *order);
  227. int ascending (void *first,void *second);
  228. int descending (void *first,void *second);
  229. int bin_search (void *array, int *length, int *key);
  230.  
  231. int q_sort (void *array,int *length,int *order)
  232. {
  233. int    status = 0; /* return value */
  234.  
  235. qsort (array,(size_t) *length,sizeof (int),
  236.  (int(*)(const void *,const void *)) ((*order == 0) ? ascending : descending));
  237. return (status);
  238. }    /* end of do_sort() */
  239.  
  240. /*    ascending()
  241. **    This function is used by qsort and/or bsearch to return a
  242. **      value based on the comparison of two inputs. qsort uses this
  243. **      function to perform an ascending sort.
  244. **      inputs: first    ptr to first element
  245. **              second   ptr to second element
  246. **      return:          result of comparison
  247. */
  248.  
  249. int ascending (void *p1, void *p2)
  250. {
  251. return ((*(int *) p1 < *(int *) p2) ? (-1) : (*(int *) p1 == *(int *) p2) ? (0) : (1));
  252. }
  253.  
  254. /*    descending()
  255. **    This function is used by qsort and/or bsearch to return a
  256. **      value based on the comparison of two inputs. qsort uses this
  257. **      function to perform a descending sort.
  258. **      inputs: first    ptr to first element
  259. **              second   ptr to second element
  260. **      return:          result of comparison
  261. */
  262.  
  263. int descending (void *p1, void *p2)
  264. {
  265. return ((*(int *) p1 < *(int *) p2) ? (1) : (*(int *) p1 == *(int *) p2) ? (0) : (-1));
  266. }
  267.  
  268. /*       bin_search()
  269. **       This function takes a sorted FORTRAN array and a key and
  270. **       attempts to locate the key value using C's bsearch(). The
  271. **       function passes back the value if found, or 0 if not found.
  272. **       inputs: array    ptr to an array
  273. **               length   length of the array
  274. **               key      ptr to a key value
  275. **       return:          result of search
  276. */
  277.  
  278. int bin_search (void *array, int *length, int *key)
  279. {
  280.    int *ptr;
  281.  
  282.    ptr = (int *) bsearch(key, array, (size_t) *length, sizeof(int), ascending);
  283.    return(ptr != NULL);
  284.  
  285. }
  286.  
  287. [EXAMPL┼ 1]
  288.  
  289.  
  290. /* Passing a string to FORTRAN from a C main() */
  291. typedef struct {
  292.    char *text;
  293.    int length;
  294. } CHARACTER;
  295.  
  296. extern void f_subroutine(int *, float *, CHARCTER *);
  297.  
  298. main() {
  299.    int ival;
  300.    float fval;
  301.    CHARACTER cval;
  302.  
  303.    cval.text = "contents of variable";
  304.    cval.length = strlen(cval.text);
  305.    f_subroutine(&ival, &fval, &cval);
  306. } /* End of C example */
  307.     
  308. c
  309. c   FORTRAN subroutine to accept and print a string
  310. c
  311. SUBROUTINE F_SUBROUTINE(I, F, C)
  312.    BCEXTERNAL F_SUBROUTINE
  313.    INTEGER*2 I    
  314.    REAL F
  315.    
  316.    CHARACTER*(*) C
  317.    PRINT I, F, C
  318. END
  319.  
  320.  
  321. [EXAMPL┼ 2]
  322.  
  323. /* C module to get FORTRAN function return value */
  324. extern void f_function(double *, double *);
  325.  
  326. c_module_main() {
  327.    double, dval, return_val;
  328.  
  329.    f_function(&return_val, &dval);
  330. }
  331.  
  332. c
  333. c FORTRAN function to calculate the cube of the input number
  334. c
  335. function f_function(x)
  336. MSCEXTERNAL f_function
  337. double precision x, f_function
  338.  
  339. f_function = x * x * x
  340. return
  341. end
  342.  
  343.  
  344.